From b5ec6f8f8d95104fd1ffb397f15aa0b818b1c272 Mon Sep 17 00:00:00 2001 From: justbur Date: Wed, 2 Dec 2015 22:27:08 -0500 Subject: [PATCH] Introduce C-h command dispatch function Replace role of show-next-page with C-h-dispatch which immediately reads a key and calls a command from C-h-map, which may be one of several paging commands, a command to undo the last keypress, or a command to directly access describe-prefix-bindings. This commit does not include documenting these changes in the readme. Note that several options become deprecated here as they no longer have the same (if any effect). --- which-key.el | 193 +++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 141 insertions(+), 52 deletions(-) diff --git a/which-key.el b/which-key.el index 57f475368cd..3a81d1f89bf 100644 --- a/which-key.el +++ b/which-key.el @@ -247,12 +247,40 @@ prefixes in `which-key-paging-prefixes'" ;; :group 'which-key ;; :type '(repeat symbol)) -(defcustom which-key-use-C-h-for-paging t +(defcustom which-key-use-C-h-commands t "Use C-h for paging if non-nil. Normally C-h after a prefix calls `describe-prefix-bindings'. This changes that command to a which-key paging command when which-key-mode is active." :group 'which-key :type 'boolean) +(defvaralias 'which-key-use-C-h-for-paging + 'which-key-use-C-h-commands) +(make-obsolete-variable 'which-key-use-C-h-for-paging + 'which-key-use-C-h-commands + "2015-12-2") + +(defvar which-key-C-h-map + (let ((map (make-sparse-keymap))) + (dolist (bind '(("\C-h" . which-key-show-standard-help) + ("h" . which-key-show-standard-help) + ("\C-n" . which-key-show-next-page-cycle) + ("n" . which-key-show-next-page-cycle) + ("\C-p" . which-key-show-previous-page-cycle) + ("p" . which-key-show-previous-page-cycle) + ("\C-u" . which-key-undo-key) + ("u" . which-key-undo-key))) + (define-key map (car bind) (cdr bind))) + map) + "Keymap for C-h commands.") + +(defvar which-key--paging-functions '(which-key-C-h-dispatch + which-key-turn-page + which-key-show-next-page + which-key-show-next-page-cycle + which-key-show-next-page-no-cycle + which-key-show-previous-page-cycle + which-key-show-previous-page-no-cycle)) + (defcustom which-key-prevent-C-h-from-cycling t "When using C-h for paging, which-key overrides the default @@ -262,6 +290,9 @@ prefixes in `which-key-paging-prefixes'" want which-key to cycle, set this to nil." :group 'which-key :type 'boolean) +(make-obsolete-variable 'which-key-prevent-C-h-from-cycling + "No longer applies. See `which-key-C-h-dispatch'" + "2015-12-2") (defcustom which-key-allow-evil-operators (boundp 'evil-this-operator) "Allow popup to show for evil operators. The popup is normally @@ -422,17 +453,17 @@ alongside the actual current key sequence when (lambda (prefix) (define-key map (kbd (concat prefix " " which-key-paging-key)) - #'which-key-show-next-page)) + #'which-key-C-h-dispatch)) which-key-paging-prefixes) map) (if which-key-mode (progn (setq which-key--echo-keystrokes-backup echo-keystrokes) (unless which-key--is-setup (which-key--setup)) - (unless (eq prefix-help-command 'which-key-show-next-page) + (unless (member prefix-help-command which-key--paging-functions) (setq which-key--prefix-help-cmd-backup prefix-help-command)) - (when which-key-use-C-h-for-paging - (setq prefix-help-command #'which-key-show-next-page)) + (when which-key-use-C-h-commands + (setq prefix-help-command #'which-key-C-h-dispatch)) (when which-key-show-remaining-keys (add-hook 'pre-command-hook #'which-key--lighter-restore)) (add-hook 'pre-command-hook #'which-key--hide-popup) @@ -502,13 +533,6 @@ starter kit for example." (setq which-key-key-replacement-alist (delete '("right" . "→") which-key-key-replacement-alist))) -;; (defun which-key--setup-undo-key () -;; "Bind `which-key-undo-key' in `which-key-undo-keymaps'." -;; (when (and which-key-undo-key which-key-undo-keymaps) -;; (dolist (map which-key-undo-keymaps) -;; (which-key-define-key-recursively -;; map (kbd which-key-undo-key) 'which-key-undo)))) - ;; (defun which-key--check-key-based-alist () ;; "Check (and fix if necessary) `which-key-key-based-description-replacement-alist'" ;; (let ((alist which-key-key-based-description-replacement-alist) @@ -781,7 +805,7 @@ total height." (defun which-key--hide-popup () "This function is called to hide the which-key buffer." - (unless (eq real-this-command 'which-key-show-next-page) + (unless (member real-this-command which-key--paging-functions) (setq which-key--current-page-n nil which-key--using-top-level nil which-key--on-last-page nil) @@ -1472,31 +1496,26 @@ area." delay nil (lambda () (let (message-log-max) (message "%s" text)))))) -(defun which-key--next-page-hint (prefix-keys page-n n-pages) +(defun which-key--next-page-hint (prefix-keys n-pages) "Return string for next page hint." (let* ((paging-key (concat prefix-keys " " which-key-paging-key)) - (paging-key-bound (eq 'which-key-show-next-page + (paging-key-bound (eq 'which-key-C-h-dispatch (key-binding (kbd paging-key)))) - (key (if paging-key-bound which-key-paging-key "C-h")) - (next-page-n (format "pg %s" (1+ (mod (1+ page-n) n-pages)))) - (use-descbind (and which-key--on-last-page which-key-use-C-h-for-paging - which-key-prevent-C-h-from-cycling))) - (when (and (or (and (< 1 n-pages) which-key-use-C-h-for-paging) - (and (< 1 n-pages) paging-key-bound) - use-descbind) + (key (if paging-key-bound which-key-paging-key "C-h"))) + (when (and (or (and (< 1 n-pages) which-key-use-C-h-commands) + (and (< 1 n-pages) paging-key-bound)) (not (and which-key-allow-evil-operators (bound-and-true-p evil-this-operator)))) - (propertize (format "[%s %s]" key - (if use-descbind "help" next-page-n)) + (propertize (format "[%s which-key cmds]" key) 'face 'which-key-note-face)))) (defun which-key--get-popup-map () (unless which-key--current-prefix (let ((map (make-sparse-keymap))) - (define-key map (kbd which-key-paging-key) #'which-key-show-next-page) - (when which-key-use-C-h-for-paging + (define-key map (kbd which-key-paging-key) #'which-key-C-h-dispatch) + (when which-key-use-C-h-commands ;; Show next page even when C-h is pressed - (define-key map (kbd "C-h") #'which-key-show-next-page)) + (define-key map (kbd "C-h") #'which-key-C-h-dispatch)) map))) (defun which-key--show-page (n) @@ -1538,7 +1557,7 @@ enough space based on your settings and frame size." prefix-keys) prefix-w-face)) (status-left (format (concat "%-" (int-to-string first-col-width) "s") status-left)) - (nxt-pg-hint (which-key--next-page-hint prefix-keys page-n n-pages)) + (nxt-pg-hint (which-key--next-page-hint prefix-keys n-pages)) new-end lines first) (cond ((and (< 1 n-pages) (eq which-key-show-prefix 'left)) @@ -1588,37 +1607,28 @@ enough space based on your settings and frame size." prefix-keys) (with-no-warnings (set-temporary-overlay-map (which-key--get-popup-map)))))) -(defun which-key-show-next-page () +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; paging functions + +(defun which-key-turn-page (&optional backward) "Show the next page of keys. Will force an update if called before `which-key--update'." - (interactive) (cond - ;; on last page and want default C-h behavior - ((and which-key--current-page-n - which-key--on-last-page - which-key-use-C-h-for-paging - which-key-prevent-C-h-from-cycling) - (which-key--hide-popup-ignore-command) - (which-key--stop-timer) - (funcall which-key--prefix-help-cmd-backup) - (which-key--start-timer)) ;; No which-key buffer showing ((null which-key--current-page-n) (let* ((keysbl (vconcat (butlast (append (this-single-command-keys) nil)))) (next-event (mapcar (lambda (ev) (cons t ev)) (listify-key-sequence keysbl)))) - (which-key--stop-timer) (setq unread-command-events next-event) - (which-key--create-buffer-and-show keysbl) - (which-key--start-timer))) + (which-key--create-buffer-and-show keysbl))) ;; which-key buffer showing. turn page (t (let ((next-event (mapcar (lambda (ev) (cons t ev)) (which-key--current-key-list))) (next-page - (if which-key--current-page-n (1+ which-key--current-page-n) 0))) - (which-key--stop-timer) + (if which-key--current-page-n + (+ which-key--current-page-n (if backward -1 1)) 0))) (setq unread-command-events next-event) (if which-key--last-try-2-loc (let ((which-key-side-window-location which-key--last-try-2-loc) @@ -1627,6 +1637,52 @@ Will force an update if called before `which-key--update'." (which-key--show-page next-page)) (which-key--start-paging-timer))))) +;;;###autoload +(defun which-key-show-standard-help () + "Call the command in `which-key--prefix-help-cmd-backup'. +Usually this is `describe-prefix-bindings'." + (interactive) + (which-key--hide-popup-ignore-command) + (funcall which-key--prefix-help-cmd-backup) + (which-key--start-timer)) + +;;;###autoload +(defun which-key-show-next-page-no-cycle () + "Show next page of keys unless on the last page, in which case +call `which-key-show-standard-help'." + (interactive) + (if (and which-key--current-page-n + which-key--on-last-page) + (which-key-show-standard-help) + (which-key-turn-page))) +(defalias 'which-key-show-next-page 'which-key-show-next-page-no-cycle) +(make-obsolete 'which-key-show-next-page 'which-key-show-next-page-no-cycle + "2015-12-2") + +;;;###autoload +(defun which-key-show-previous-page-no-cycle () + "Show previous page of keys unless on the first page, in which +case do nothing." + (interactive) + (if (and which-key--current-page-n + (eq which-key--current-page-n 0)) + nil + (which-key-turn-page t))) + +;;;###autoload +(defun which-key-show-next-page-cycle () + "Show the next page of keys, cycling from end to beginning +after last page." + (interactive) + (which-key-turn-page)) + +;;;###autoload +(defun which-key-show-previous-page-cycle () + "Show the previous page of keys, cycling from beginning to end +after first page." + (interactive) + (which-key-turn-page t)) + ;;;###autoload (defun which-key-show-top-level () "Show top-level bindings." @@ -1634,16 +1690,49 @@ Will force an update if called before `which-key--update'." (setq which-key--using-top-level t) (which-key--create-buffer-and-show nil)) -(defun which-key-undo () +;;;###autoload +(defun which-key-undo-key () "Undo last keypress and force which-key update." (interactive) - (let* ((key-str (this-command-keys)) - (key-str (substring key-str 0 (- (length key-str) 2))) - (ev (mapcar (lambda (ev) (cons t ev)) (listify-key-sequence key-str)))) + (let* ((key-lst (butlast (which-key--current-key-list) 1))) + (if key-lst + (progn + (setq unread-command-events + (mapcar (lambda (ev) (cons t ev)) key-lst)) + (which-key--create-buffer-and-show + (key-description key-lst))) + (which-key-show-top-level))) + (which-key--start-timer)) +(defalias 'which-key-undo 'which-key-undo-key) + +(defun which-key-nil () + "Abort key sequence." + (interactive) + (message "abort") + (which-key--start-timer)) + +;;;###autoload +(defun which-key-C-h-dispatch () + "Dispatch C-h commands by looking up key in +`which-key-C-h-map'. This command is always accessible (from any +prefix) if `which-key-use-C-h-commands' is non nil." + (interactive) + (let* ((prefix-keys (key-description which-key--current-prefix)) + (prefix-w-face (if (eq which-key-show-prefix 'echo) prefix-keys + (which-key--propertize-key prefix-keys))) + (dash-w-face (if which-key--current-prefix + (if (eq which-key-show-prefix 'echo) "-" + (propertize "-" 'face 'which-key-key-face)) + "")) + (k (string + (read-key + (concat prefix-w-face dash-w-face + (propertize " [n]ext-page, [p]revious-page, [u]ndo-key, [h]elp" + 'face 'which-key-note-face))))) + (cmd (lookup-key which-key-C-h-map k)) + which-key-inhibit) (which-key--stop-timer) - (setq unread-command-events ev) - (which-key--create-buffer-and-show key-str) - (which-key--start-timer))) + (if cmd (funcall cmd) (which-key-nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update @@ -1727,7 +1816,7 @@ Finally, show the buffer." (setq which-key--paging-timer (run-with-idle-timer 0.2 t (lambda () - (when (or (not (eq real-last-command 'which-key-show-next-page)) + (when (or (not (member real-last-command which-key--paging-functions)) (and (< 0 (length (this-single-command-keys))) (not (equal which-key--current-prefix (this-single-command-keys))))) -- 2.30.2